home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 04 - 1988 / 04.09 Sep 88 / Dubin Article / TMLPascal Version / TMPasArea.Pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-08-29  |  7.8 KB  |  358 lines  |  [TEXT/MACA]
  1. { TMPasArea.pas  written by Stephen Dubin, V.M.D., Ph.D.}
  2. { Prepared for use with TML Pascal System 2.0}
  3. { Latest Revision  8/29/87}
  4. program TMPasArea;
  5.  
  6. {$T APPL AREA        }    { set the type and creator}
  7. {$B+            }    { set the bundle bit}
  8. {$L TMPasAreaRes    }    { link the resource file too...}
  9.  
  10. uses MacIntf;
  11.  
  12. const
  13.   FileMenuID = 1;        { the File menu}
  14.   OptionMenuID = 2;        { the option menu}
  15.   WindResID = 1;        { the resource id of my window}
  16.  
  17. type
  18.   BUF   = array[1..512] of Integer; { Make it bigger if you are really paranoid}
  19.   
  20. var
  21.   myMenus : Array[FileMenuId..OptionMenuID] of MenuHandle; 
  22.   Done : Boolean;            
  23.   MyWindow : WindowPtr;        
  24.   TotalRegion   :   RgnHandle;
  25.   Numpix        :   Longint;
  26.   NumTrap       :   Longint;
  27.   myBUF        : BUF;
  28.     
  29. {    Declare the Assembly Language routine as external }
  30. function ACountPix( theRegion:RgnHandle) : LongInt; external;
  31. {$U ACountPix    } 
  32. {Note: It seems the .link file does not recognise this directive }
  33. {if it appears above with the other compiler directives}
  34.  
  35. function CountPix(theRegion : RgnHandle): LongInt;        
  36. var
  37.  pt : Point;
  38.  rgn    :   Region;
  39.  temp   :   LongInt;
  40.  x    :   Integer;
  41.  y    :   Integer;
  42.   
  43. begin
  44.    temp   :=  0;
  45.    rgn  :=  theRegion^^;
  46.    for  x  := rgn.rgnBBox.left  to  rgn.rgnBBox.right do 
  47.         begin
  48.         pt.h := x;
  49.             for y := rgn.rgnBBox.top to rgn.rgnBBox.bottom do
  50.             begin
  51.         pt.v := y;
  52.                 if  PtInRgn( pt, TheRegion) then  temp := temp + 1;
  53.         end;
  54.         end;
  55.         CountPix := temp;
  56. end;
  57. { Notice: TML does not seem to like having pt.h and pt.v as control elements}
  58.  
  59. procedure Wipe;    
  60. var
  61.     r   :   Rect;
  62.   
  63.   
  64. begin
  65.     SetRect(r,0,0,504,300);
  66.     EraseRect(r);
  67.   
  68. end;
  69.  
  70. procedure Data;        
  71. var
  72.     rgn         :   Region;
  73.     rgnpntr     :   Ptr;
  74.     size        :   Integer;
  75.     thebuf      :   BUF;
  76.     bfpntr      :   Ptr;
  77.     myString    :   Str255;
  78.     i           :   Integer;
  79.     x           :   Integer;
  80.     y           :   Integer;
  81.  
  82.  begin
  83.     Wipe;
  84.     TextSize(9);
  85.     TextFont(Monaco);
  86.     rgn  :=  totalRegion^^;
  87.     rgnpntr := ptr(totalRegion^); 
  88.     size := rgn.rgnSize;
  89.     if size > 800 then size:= 800;
  90.     bfpntr := ptr(@thebuf);
  91.     BlockMove(rgnpntr,bfpntr,size);
  92.     MoveTo(10,10);
  93.     DrawString('Here are the first 400 words of the region data. (FLAG = 32767)');
  94.     x := 10;
  95.     y := 20;
  96.     for i  := 1  to  (size div 2) do 
  97.         begin
  98.         MoveTo(x,y);
  99.         NumToString(theBuf[i],myString);
  100.         if theBuf[i] < 32766 then 
  101.             begin
  102.                 if theBuf[i] <10  then DrawString(' ');
  103.                 if theBuf[i] <100 then DrawString(' ');
  104.                 if theBuf[i] < 1000 then DrawString(' ');
  105.                 if theBuf[i] < 10000 then DrawString(' ');
  106.                 DrawString(MyString);
  107.             end;
  108.         if theBuf[i] > 32766 then DrawString(' FLAG');
  109.         x := x + 30;
  110.         if (i mod 16) = 0 then
  111.             begin
  112.             x := 10;
  113.             y := y+10;
  114.             end; 
  115.         end;
  116.     
  117. end;
  118.  
  119.  
  120. procedure OvalRegion;        
  121. var
  122.     RectA : Rect;
  123.       
  124. begin
  125.    Wipe;   
  126.    TotalRegion := NewRgn;
  127.    SetRect(RectA, 170,175,195,200);
  128.    OpenRgn;
  129.    ShowPen;
  130.    FrameOval(RectA);
  131.    HidePen;
  132.    CloseRgn(TotalRegion);   
  133. end;
  134.  
  135. procedure Contour;        
  136. var
  137.     p1  :   Point;
  138.     p2  :   Point;
  139.     OldTick :  Longint;
  140.     
  141. begin
  142.  
  143.   Wipe;
  144.   TotalRegion := NewRgn;
  145.   OldTick := TickCount;
  146.   Repeat
  147.     GetMouse(p1);
  148.     MoveTo(p1.h,p1.v);
  149.     p2 := p1;  
  150.   Until Button = True;  
  151.   OpenRgn;
  152.   ShowPen;
  153.   PenMode(patXor);  
  154.   Repeat
  155.     GetMouse(p2);
  156.     Repeat Until (OldTick <> TickCount);
  157.     LineTo(p2.h,p2.v);
  158.   Until Button <> True;  
  159.   Repeat Until (OldTick <> TickCount);
  160.   LineTo(p1.h,p1.v);
  161.   PenNormal;
  162.   HidePen;
  163.   CloseRgn(TotalRegion);
  164.   InvertRgn(TotalRegion);
  165. end;
  166.  
  167. procedure Example;        
  168.   
  169. begin
  170.     Wipe;
  171.     OpenRgn;
  172.     TotalRegion := NewRgn;
  173.     ShowPen;
  174.     MoveTo(100,100);
  175.     LineTo(200,100);
  176.     LineTo(200,220);
  177.     LineTo(180,220);
  178.     LineTo(180,150);
  179.     LineTo(125,150);
  180.     LineTo(125,170);
  181.     LineTo(125,170);
  182.     LineTo(100,170);
  183.     LineTo(100,100);
  184.     HidePen;
  185.     CloseRgn(TotalRegion);
  186. end;
  187.  
  188. procedure FreeBox;        
  189. var
  190.     p1  :   Point;
  191.     p2  :   Point;
  192.     p3  :   Point;
  193.     OldTick :  Longint;
  194.     MyRect  :  Rect;
  195.       
  196. begin
  197.     Wipe;
  198.     TotalRegion := NewRgn;
  199.     OldTick := TickCount;
  200.     PenPat(gray);
  201.     PenMode(patXor);    
  202.     Repeat
  203.     GetMouse(p1);
  204.     p2 := p1;  
  205.     Until Button = True;   
  206.     OpenRgn;
  207.     ShowPen;
  208.     PenMode(patXor);    
  209.     Repeat
  210.     Pt2Rect(p1,p2,MyRect);
  211.     Repeat Until (OldTick <> TickCount);
  212.     FrameRect(MyRect);   
  213.         Repeat
  214.             GetMouse(p3);
  215.         Until  EqualPt(p2,p3) <> True;   
  216.    Repeat Until (OldTick <> TickCount);
  217.    FrameRect(MyRect);
  218.    p2 := p3;   
  219.    Until Button <> True;
  220.    Pennormal;
  221.    HidePen;
  222.    PenPat(black);
  223.    FrameRect(MyRect);
  224.    CloseRgn(TotalRegion);
  225.    InvertRgn(TotalRegion);  
  226. end;
  227.  
  228. procedure Area;        
  229. var
  230.     NumTix  :   LongInt;
  231.     MoreTix :   LongInt;
  232.     TicString   :   Str255;
  233.     PixString   :   Str255;
  234.     TrapString  :   Str255;  
  235.   
  236. begin   
  237.    TextFont(Monaco);
  238.    TextSize(9);
  239.    TextMode(0);
  240.    MoveTo(10,20); DrawString(' Using Pascal '); 
  241.    NumTix := TickCount;
  242.    NumPix :=  CountPix( TotalRegion ); 
  243.    MoreTix := TickCount - NumTix;
  244.    NumToString(MoreTix,TicString);
  245.    NumToString(NumPix,PixString);
  246.    MoveTo(10,30); DrawString(' Tickcount = ');
  247.    MoveTo(120,30); DrawString(TicString);
  248.    MoveTo(10,40); DrawString(' Pixel Number = ');
  249.    MoveTo(120,40); DrawString(PixString);    
  250.    MoveTo(10,50); DrawString(' Using Tom Terrific '); 
  251.    NumTix := TickCount;
  252.    NumPix :=  ACountPix( TotalRegion ); 
  253.    MoreTix := TickCount - NumTix;
  254.    NumToString(MoreTix,TicString);
  255.    NumToString(NumPix,PixString);
  256.    MoveTo(10,60); DrawString(' Tickcount = ');
  257.    MoveTo(120,60); DrawString(TicString);
  258.    MoveTo(10,70); DrawString(' Pixel Number = ');
  259.    MoveTo(120,70); DrawString(PixString);  
  260. end;
  261.  
  262. procedure ProcessMenu(codeWord : Longint);
  263. var
  264.   menuNum : Integer;
  265.   itemNum : Integer;
  266.  
  267. begin
  268.   if codeWord <> 0 then    
  269.     begin
  270.       menuNum := HiWord(codeWord);
  271.       itemNum := LoWord(codeWord);
  272.       case menuNum of { the different menus}
  273.            FileMenuID :Done := true; 
  274.         OptionMenuID :
  275.                begin
  276.                 case ItemNum of
  277.                     1:Contour;      {Contour}
  278.                     2:FreeBox;      {Freebox}
  279.                     3:OvalRegion;   {Oval}
  280.                     4:Example;      {Example}
  281.                     5: Area;        {Area}
  282.                     6:Data;         {Region Data}
  283.                    end; { of ItemNum case}               
  284.        end;{ of MenuNum case}
  285.     end;
  286.   HiliteMenu(0); 
  287.  end;
  288. end;
  289.  
  290. procedure DealWithMouseDowns(theEvent: EventRecord);
  291. var
  292.   location : Integer;
  293.   windowPointedTo : WindowPtr;
  294.   mouseLoc : point;
  295.   windowLoc : integer;
  296.   VandH : Longint;
  297.   Height : Integer;
  298.   Width : Integer;
  299.  begin
  300.   mouseLoc := theEvent.where;
  301.   windowLoc := FindWindow(mouseLoc,windowPointedTo);
  302.   case windowLoc of
  303.     inMenuBar : 
  304.       begin
  305.         ProcessMenu(MenuSelect(mouseLoc));
  306.       end;
  307.     
  308.   end;
  309. end;
  310.  
  311. procedure MainEventLoop;
  312. var
  313.   Event : EventRecord;
  314.   theItem : integer;
  315.   
  316. begin
  317.   repeat
  318.     SystemTask;
  319.     if GetNextEvent(everyEvent, Event) then
  320.      begin  
  321.          case Event.what of
  322.           mouseDown : DealWithMouseDowns(Event);
  323.          end;
  324.      end;
  325.   until Done;
  326. end;
  327.  
  328. procedure MakeMenus;        
  329. var
  330.   index : Integer;
  331. begin
  332.   for index := FileMenuId to OptionMenuID do
  333.     begin
  334.       myMenus[index] := GetMenu(index);
  335.       InsertMenu(myMenus[index],0);
  336.     end;
  337.   DrawMenuBar;
  338. end;
  339.  
  340.  
  341. begin
  342.   Done := false;        
  343.   FlushEvents(everyEvent,0);    
  344.   InitGraf(@thePort);        
  345.   InitFonts;        
  346.   InitWindows;        
  347.   InitMenus;        
  348.   InitDialogs(nil);
  349.   InitCursor;        
  350.   MoreMasters;
  351.   MoreMasters;
  352.   MakeMenus;        
  353.   MyWindow := GetNewWindow(WindResID,nil,Pointer(-1)); 
  354.   SetPort(MyWindow);    
  355.   TotalRegion := NewRgn;   {Lazy way to avoid bomb if your select "Area" first}  
  356.   MainEventLoop;        
  357. end.
  358.